home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
vmmngr.zip
/
VMM.IN4
< prev
next >
Wrap
Text File
|
1990-07-16
|
9KB
|
274 lines
{*********************************************************}
{* VMM.IN4 1.00 *}
{*********************************************************}
{+++ Internal methods +++}
function VMM.PageOut(SizeNeeded : LongInt) : Boolean;
{-Page out until "SizeNeeded" bytes become available in the Ram area}
{ Return false if not possible}
var
Failed : Boolean;
CurHandle : VmmHandle;
SD : VmmDescriptor;
D : VmmDescriptor;
P : VmmPtr;
Index : Byte;
Err : Word;
begin
Failed := false;
if vmLruQueue.IsEmpty then begin {Nothing to page out - this}
PageOut := false; { error should not occur unless}
Exit; { ClearRamArea has been called}
end; { twice in a row}
while (not vmLruQueue.IsEmpty)
and (RamMaxAvail < SizeNeeded)
and not Failed do begin
vmLruQueue.PeekHead(CurHandle); {Get next LRU handle}
vmDescTable.GetElem(CurHandle, D); {Load descriptor}
if vmDescTable.GetStatus <> 0 then begin
PageOut := false;
Error(epFatal+ecBadParam);
Exit;
end;
SD := D;
Failed := true; {Assume failure}
if EmsMaxAvail >= D.Size then begin
{Find a free entry or allocate Ems then map Ems and move data}
P := vmEmsFreeList.GetFreeEntry(D.Size);
if P <> nil then
D.Ptr := P
else begin
{Allocate Ems}
D.Handle := AllocateEmsPages(4);
if D.Handle = EmsErrorCode then begin
PageOut := false;
Error(epFatal+ecEmsAllocation);
Exit;
end;
D.Offset := 0;
{Add free entry to make later use of remaining space in frame}
if vmEmsFreeList.AddFreeEntry(Ptr(D.Handle, D.Size),
MaxEmsBlock-D.Size) = 0 then
Error(epNonFatal+ecOutOfEmsEntries);
end;
if not SaveEmsContext(D.Handle) then begin
PageOut := false;
Error(epFatal+ecEmsPageMapping);
Exit;
end;
{Map Ems - We deal with 64k blocks only}
for Index := 0 to 3 do
if not MapEmsPage(D.Handle, Index, Index) then begin
PageOut :=false;
Error(epFatal+ecEmsPageMapping);
Exit;
end;
{Move data to Ems}
Move(SD.RamPtr^, Ptr(vmEmsBaseSeg, D.Offset)^, D.Size);
if not RestoreEmsContext(D.Handle) then begin
PageOut := false;
Error(epFatal+ecEmsPageMapping);
Exit;
end;
D.Location := vmInEms;
Failed := false;
end
else if DskMaxAvail >= D.Size then begin
{Allocate disk space and move data}
P := vmDskFreeList.GetFreeEntry(D.Size);
if P <> nil then
D.DskPtr := LongInt(P)
else begin
{No free block - append to end of file}
D.DskPtr := vmEofPtr;
Inc(vmEofPtr, D.Size);
end;
Seek(vmF, D.DskPtr);
BlockWrite(vmF, SD.RamPtr^, D.Size);
Err := IoResult;
if Err <> 0 then begin
PageOut := false;
Error(epFatal+Err);
Exit;
end;
D.Location := vmOnDsk;
Failed := false;
end;
if not Failed then begin
{Block has been paged out}
{Update RamFreeList and descriptor table}
if vmRamFreeList.AddFreeEntry(SD.RamPtr, D.Size) = 0 then
Error(epNonFatal+ecOutOfRamEntries);
vmDescTable.SetElem(CurHandle, D);
{Remove handle from free list only if paged out}
vmLruQueue.PopHead(CurHandle);
end;
end;
PageOut := RamMaxAvail >= SizeNeeded;
end;
function VMM.GetHandle : Word;
{-Return a valid VMM handle}
var
CurIndex : Word;
CurDesc : VmmDescriptor;
LastIndex : Word;
begin
with vmDescTable do begin
if daValidElems = 0 then
GetHandle := 0
else begin
LastIndex := Pred(daValidElems);
for CurIndex := 0 to LastIndex do begin
{Look for a null entry in descriptor table}
GetElem(CurIndex, CurDesc);
if CurDesc.Location = 0 then begin
{Assume that entry is free if Location is null}
GetHandle := CurIndex;
Exit;
end;
end;
{not found, the next one will be the last valid one + 1}
if LastIndex >= GetMaxIndex then begin
GetHandle := OutOfHandles;
Error(epFatal+ecOutOfDescEntries);
end
else
GetHandle := Succ(LastIndex);
end;
end;
end;
destructor VMMDescriptorTable.Done;
{-Deallocate all Ems handles held in descriptor table}
var
D : VmmDescriptor;
Index : Word;
begin
if daValidElems > 0 then
for Index := 0 to Pred(daValidElems) do begin
GetElem(Index, D);
if FlagIsSet(Word(D.Location), vmInEms)
and not DeAllocateEmsHandle(D.Handle) then
Error(epNonFatal+ecCantFreeEms);
end;
DynArray.Done;
end;
{---------------------------------------------------------------------}
{+++ Internal procedures +++}
function VmmGetMem(var P; Size : LongInt) : Boolean;
{-Allocate heap space, returning true if successful}
{ Default function for UserGetMem}
var
Pt : Pointer absolute P;
begin
GetMem(Pt, Word(Size)); {We only use WORDs inside a VMM}
VmmGetMem := (Pt <> nil);
end;
procedure VmmFreeMem(var P; Size : LongInt);
{-Deallocate heap space}
{ Default procedure for UserFreeMem}
var
Pt : Pointer absolute P;
begin
if Pt <> nil then begin
FreeMem(Pt, Word(Size)); {We only use WORDs inside a VMM}
Pt := nil;
end;
end;
procedure DerefHandler(AX, BX, CX, DX, SI ,DI, DS, ES, BP : Word);
interrupt;
{-Called when a pointer is dereferenced with VmmDrf}
var
P : Pointer;
D : VmmDescriptor;
H : Word;
Err : Word;
Location : Byte;
Page : Byte;
Locked : Boolean;
begin
with VmmActiveMgr^ do begin {VMM selected with LinkToDerefHandler}
{AX contains VMM handle}
H := AX; {Save Handle}
vmDescTable.GetElem(H, D); {Get descriptor}
if (BX = VmmMark) and (vmDescTable.GetStatus = 0) then begin
Locked := FlagIsSet(Word(D.Location), vmLocked);
Location := D.Location and vmLocation;
case Location of
vmInRam:
begin {Block is in Ram area}
DX := VmmPtrRec(D.RamPtr).Seg;
AX := VmmPtrRec(D.RamPtr).Ofs;
end;
vmInEms, vmOnDsk:
begin {Block is in Ems or on Disk}
{Make room for block in Ram if necessary}
if not(RamMaxAvail >= D.Size) then
if not PageOut(D.Size) then
ErrorExit(213); {dead lock - shouldn't occur}
P := vmRamFreeList.GetFreeEntry(D.Size);
{P cannot be nil if we get here}
case Location of
vmInEms:
begin {Ems}
if not SaveEmsContext(D.Handle) then
ErrorExit(212);
for Page := 0 to 3 do
if not MapEmsPage(D.Handle, Page, Page) then
ErrorExit(212);
Move(Ptr(vmEmsBaseSeg, D.Offset)^, P^, D.Size);
if not RestoreEmsContext(D.Handle) then
ErrorExit(212);
if vmEmsFreeList.AddFreeEntry(D.Ptr, D.Size) = 0 then
Error(epNonFatal+ecOutOfEmsEntries);
end;
vmOnDsk:
begin {Disk}
Seek(vmF, D.DskPtr);
BlockRead(vmF, P^, D.Size);
Err := IOResult;
if Err <> 0 then
ErrorExit(Err); {Can only generate run-time error}
if vmDskFreeList.AddFreeEntry(D.Ptr, D.Size) = 0 then
Error(epNonFatal+ecOutOfDskEntries);
end;
end;
{Update descriptor table}
D.Location := vmInRam;
D.RamPtr := P;
vmDescTable.SetElem(H, D);
{Return pointer to block in ram area}
DX := VmmPtrRec(P).Seg;
AX := VmmPtrRec(P).Ofs;
end;
else {Handle not recognized}
ErrorExit(204); {Invalid pointer operation}
end;
{Add handle to LRU queue}
if not Locked then with vmLruQueue do begin
Remove(H); {Make H a unique handle in the LRU queue}
PushTail(H);
end;
end
else begin
{Must be a normal TP pointer - return it unchanged}
DX := AX;
AX := BX;
end;
end;
end;